Module mod_relogios

  ! FINALIDADE
  !   Monitora tempo de execucao de trechos selecionados de um programa
  !
  ! SINOPSE
  !   Fornece abstracao simples: um conjunto de relogios, um para cada
  ! trecho do programa. A cada instante durante a execucao, um unico relogio
  ! esta ativo, medindo o tempo de execucao do trecho selecionado. A invocacao
  ! de "TrocaRelogio" sinaliza o fim do trecho atualmente medido e o inicio
  ! do novo trecho a medir.
  ! 
  ! USO
  !   Todos os relogios devem ser criados antes de usados, pela invocacao do
  ! procedimento CriaRelogio. Sugerimos invocar CriaRelogio no programa principal,
  ! imediatamente apos abrir o paralelismo MPI. Argumentos de CriaRelogio sao o numero
  ! de relogios a criar, qual relogio deve ser ligado nesse ponto do programa e 
  ! um array de caracteres com o nome dos relogios.
  !   Sugerimos criar um relogio exclusivamente para as regioes nao medidas do 
  ! programa, tipicamente denominado "Resto". CriaRelogios obrigatoriamente cria 
  ! um relogio a mais que o solicitado, escondido do usuario, para acumular o 
  ! tempo total.
  !   Os relogios sao numerados de 1 a "n", onde "n" eh o primeiro argumento de
  ! CriaRelogio. Relogio "i" eh associado ao i-esimo nome fornecido a CriaRelogios.
  !   Para trocar o relogio em um ponto do programa (fim de um trecho e inicio de
  ! outro), invoque TrocaRelogio, passando o numero do relogio a ligar.
  !   A rotina DumpRelogio imprime os tempos de execucao de cada relogio desde o 
  ! inicio de programa ate o ponto de invocacao. Os tempos sao impressos no arquivo
  ! Dump.XXXX.YYYY onde YYYY eh o numero de processos MPI na execucao e XXXX eh o
  ! rank MPI do processo. Os arquivos Dump sao abertos em CriaRelogio e permanecem
  ! abertos ateh a invocacao de DestroiRelogio.
  !   Os relogios sao destruidos ao final da execucao do programa por DestroiRelogio.
  ! 
  ! BONUS
  !   A constante simbolica "semInstrumentacao", privada a este modulo, permite
  ! desligar a instrumentacao (se verdadeira) sem alterar o fonte do programa medido.

  implicit none
  private
  public :: CriaRelogio
  public :: TrocaRelogio
  public :: DumpRelogio
  public :: DestroiRelogio

  integer, parameter :: i8=8  ! deveria ser selected_int_kind

  integer, parameter               :: unitDump=20     !numero da unidade de I/O
  integer                          :: nRelogios       !numero de relogios
  integer                          :: relAtual        !relogio atual
  integer                          :: relTotal        !relogio acumulador
  character(len=16), allocatable   :: NomeRelogios(:) !nomes dos relogios
  integer(i8),       allocatable   :: Tempos(:,:)     !tempos dos relogios
  integer(i8),       allocatable   :: Instancias(:)   !quantas instancias de cada relogio

  integer, parameter :: IndUser=1, IndWall=2
  real, parameter :: count_real=1000000.0
  integer :: count_rate
  logical, parameter :: dumpLocal=.false.
  logical, parameter :: semInstrumentacao=.false.


  include 'mpif.h'

contains



  ! CriaRelogio:
  !  Cria 'nt' relogios, numerados de 1 a nt, denominados nomes(:);
  !  Ativa relogio numero 'prim'



  subroutine CriaRelogio(nt, prim, nomes)
    integer, intent(IN) :: nt   ! quantos relogios 
    integer, intent(IN) :: prim ! qual relogio ativar no inicio
    character(len=*), intent(IN) :: nomes(:) ! nomes dos relogios

    integer :: iRel
    integer :: nNomes
    integer :: ierr
    integer(i8) :: tCpu, tWall
    integer :: tamNomeProc
    integer :: maxNodes
    integer :: myId
    character(len=MPI_MAX_PROCESSOR_NAME) :: nomeProc
    character(len=8) :: c0, c1
    character(len=*), parameter :: h='**(CriaRelogio)**'
    character(len=4)  :: caux
    character(len=14) :: nomeArqDump
    character(len=4) :: cNProc      ! maxNodes in characters, for printing
    character(len=4) :: cThisProc   ! myId in characters, for printing

    ! retorna se instrumentacao desligada

    if (semInstrumentacao) return

    ! consistencia dos dados de entrada

    if (nt < 1) then
       write(c0,"(i8)") nt
       call FatalError (h//" poucos relogios: "//trim(adjustl(c0)))
    end if
    if (prim < 1 .or. prim > nt) then
       write(c0,"(i8)") prim
       call FatalError (h//" primeiro relogio inadequado "//trim(adjustl(c0)))
    end if
    nNomes=size(nomes,1)
    if (nNomes /= nt) then
       write (c0,"(i8)") nNomes
       write (c1,"(i8)") nt
       call FatalError (h//" ha "//trim(adjustl(c0))//" nomes para "//&
            trim(adjustl(c1))//" relogios")
    end if

    ! coleta MPI size, rank, processor name, 
    ! cria nome e abre arquivo Dump

    call MPI_COMM_SIZE(MPI_COMM_WORLD, maxNodes , ierr)
    if (ierr /= MPI_SUCCESS) then
       write(c0,"(i8)") ierr
       call FatalError(h//" MPI_COMM_SIZE retorna erro "//trim(c0))
    end if

    call MPI_COMM_RANK(MPI_COMM_WORLD, myId, ierr)
    if (ierr /= MPI_SUCCESS) then
       write(c0,"(i8)") ierr
       call FatalError(h//" MPI_COMM_RANK retorna erro "//trim(c0))
    end if

    call MPI_GET_PROCESSOR_NAME(nomeProc, tamNomeProc, ierr)
    if (ierr /= MPI_SUCCESS) then
       write(c0,"(i8)") ierr
       call FatalError(h//" MPI_GET_PROCESSOR_NAME retorna erro "//trim(c0))
    end if

    write(cNProc ,"(i4.4)") maxNodes
    write(cThisProc,"(i4.4)") myId
    nomeArqDump="Dump."//cThisProc//"."//cNProc
    open(unitDump, FILE=nomeArqDump, STATUS='replace', IOSTAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" OPEN arquivo "//nomeArqDump//" retorna erro "//trim(c0))
    END IF

    write(unitDump,"(a)") h//" Processo MPI "//TRIM(ADJUSTL(cThisProc))//" dentre "//TRIM(ADJUSTL(cNProc))//&
         " no processador "//nomeProc(1:tamNomeProc)//" esta vivo"

    ! inicializa globais

    nRelogios=nt
    relAtual=prim
    relTotal=nRelogios+1

    ! aloca estrutura de dados

    allocate(NomeRelogios(nRelogios+1), STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" alocacao de NomeRelogios falha com STAT="//trim(adjustl(c0)))
    end if
    allocate(Tempos(nRelogios+1,2), STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" alocacao de Tempos falha com STAT="//trim(adjustl(c0)))
    end if
    allocate(Instancias(nRelogios+1), STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" alocacao de Instancias falha com STAT="//trim(adjustl(c0)))
    end if

    ! inicializa NomeRelogios

    do iRel = 1, nRelogios
       NomeRelogios(iRel) = nomes(iRel)
    end do
    NomeRelogios(relTotal) = "Total"

    ! inicializa Tempos

    Tempos(:,:) = 0_i8
    call MedeTempos(tCpu,tWall)
    Tempos(relTotal,IndWall) = -tWall
    Tempos(relTotal,IndUser) = -tCpu
    Tempos(relAtual,:) = Tempos(relTotal,:)

    ! inicializa Instancias

    Instancias(1:nRelogios+1) = 0_i8
    Instancias(relAtual) = 1_i8
    Instancias(relTotal) = 1_i8

    if (dumpLocal) then
       call DumpTempos("inicializacao")
    end if
  end subroutine CriaRelogio



  ! TrocaRelogio:
  !  Desliga o relogio atual e liga relogio numero 'tp'



  subroutine TrocaRelogio(tp)
    integer, intent(in) :: tp ! numero do relogio a ligar

    character(len=80) :: linha
    integer(i8) :: tCpu, tWall
    character(len=*), parameter :: h='**(TrocaRelogio)**'


    ! retorna se instrumentacao desligada

    if (semInstrumentacao) return

    if (dumpLocal) then
       linha = "troca "//trim(NomeRelogios(relAtual))//" por "//&
            trim(NomeRelogios(tp))
    end if

    ! obtem dados deste instante

    call MedeTempos(tCpu,tWall)

    ! fecha o contador anterior

    Tempos(relAtual,IndUser) = Tempos(relAtual,IndUser) + tCpu
    Tempos(relAtual,IndWall) = Tempos(relAtual,IndWall) + tWall

    ! abre o novo contador

    relAtual=tp
    Tempos(relAtual,IndUser) = Tempos(relAtual,IndUser) - tCpu
    Tempos(relAtual,IndWall) = Tempos(relAtual,IndWall) - tWall

    ! contador de instancias

    Instancias(relAtual) = Instancias(relAtual) + 1_i8
    Instancias(relTotal) = Instancias(relTotal) + 1_i8
    if (dumpLocal) then
       call DumpTempos(trim(linha))
    end if
  end subroutine TrocaRelogio



  ! DumpRelogio
  !   Dump os valores dos contadores e dos relogios desde o inicio da computacao



  subroutine DumpRelogio()
    integer(i8) :: tCpu, tWall
    character(len=30) :: fmt
    character(len=*), parameter :: h="**(DumpRelogio)**"
    integer :: iRel


    ! retorna se instrumentacao desligada

    if (semInstrumentacao) return

    ! obtem dados deste instante

    call MedeTempos(tCpu,tWall)

    ! fecha o contador atual

    Tempos(relAtual,IndUser) = Tempos(relAtual,IndUser) + tCpu
    Tempos(relAtual,IndWall) = Tempos(relAtual,IndWall) + tWall

    ! fecha o contador total

    Tempos(relTotal,IndUser) = Tempos(relTotal,IndUser) + tCpu
    Tempos(relTotal,IndWall) = Tempos(relTotal,IndWall) + tWall

    ! dump

    write(unitDump,"('Tempo User:',i12,' por segundo')") int(count_real,i8)
    write(unitDump,"('Tempo Wall:',i12,' por segundo')") int(count_rate,i8)
    fmt="(17x,3a20)"
    write(unitDump,fmt) "  Instancias", "  Tempo User", "  Tempo Wall"

    fmt="(1x,a16,3i20)"
    do iRel = 1, nRelogios+1
       write(unitDump,fmt) NomeRelogios(iRel), Instancias(iRel), &
            Tempos(iRel,1:2)
    end do

    ! abre o contador atual

    Tempos(relAtual,IndUser) = Tempos(relAtual,IndUser) - tCpu
    Tempos(relAtual,IndWall) = Tempos(relAtual,IndWall) - tWall

    ! abre o contador total

    Tempos(relTotal,IndUser) = Tempos(relTotal,IndUser) - tCpu
    Tempos(relTotal,IndWall) = Tempos(relTotal,IndWall) - tWall
  end subroutine DumpRelogio



  ! DestroiRelogio:
  !   Destroi todos os relogios - desaloca memoria



  subroutine DestroiRelogio()
    integer :: ierr
    integer(i8) :: tCpu, tWall
    character(len=8) :: c0
    character(len=20), parameter :: h='**(DestroiRelogio)**'

    ! retorna se instrumentacao desligada

    if (semInstrumentacao) return

    ! obtem dados deste instante

    call MedeTempos(tCpu,tWall)

    ! fecha o contador atual

    Tempos(relAtual,IndUser) = Tempos(relAtual,IndUser) + tCpu
    Tempos(relAtual,IndWall) = Tempos(relAtual,IndWall) + tWall

    ! fecha o contador total

    Tempos(relTotal,IndUser) = Tempos(relTotal,IndUser) + tCpu
    Tempos(relTotal,IndWall) = Tempos(relTotal,IndWall) + tWall

    ! dealoca

    deallocate(NomeRelogios, STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" dealocar NomeRelogios falha com STAT="//trim(adjustl(c0)))
    end if
    deallocate(Tempos, STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" dealocar Tempos falha com STAT="//trim(adjustl(c0)))
    end if
    deallocate(Instancias, STAT=ierr)
    if (ierr /= 0) then
       write(c0,"(i8)") ierr
       call FatalError(h//" dealocar Instancias falha com STAT="//trim(adjustl(c0)))
    end if

    ! fecha arquivo dump

    close(unitDump)
  end subroutine DestroiRelogio


  ! MedeTempos:
  !   Rotina privada deste modulo. Permite alterar a forma de medir tempos ao
  !   mover o modulo por sistemas distintos.


  subroutine MedeTempos(tCpu, tWall)
    integer(i8), intent(out) :: tCpu, tWall
    real :: rtCpu
    integer :: count
    character(len=*), parameter :: h="**(MedeTempos)**"
    call cpu_time(rtCpu); tCpu=INT(rtCpu*count_real,i8)
    call system_clock(count, count_rate); tWall=INT(count,i8)
    if (dumpLocal) then
       write(unitDump,*) h//" rtCpu, tCpu, count,tWall=",rtCpu,tCpu,count,tWall
    end if
  end subroutine MedeTempos


  ! DumpTempos:
  !   Rotina privada deste modulo, usada para depuracao do modulo.


  subroutine DumpTempos(str)
    character(len=*), intent(in) :: str
    integer :: iRel
    character(len=*), parameter :: h="**(DumpTempos)**"
    write(unitDump,"(a)") trim(str)
    do iRel = 1, nRelogios+1
       write(unitDump,"(1x,a20,2i20)") trim(h//NomeRelogios(iRel)), &
            Tempos(iRel,1:2)
    end do
  end subroutine DumpTempos





  SUBROUTINE FatalError(message)
    CHARACTER(LEN=*), INTENT(IN) :: message
    INTEGER :: ierror
    INTEGER :: ierr
    CHARACTER(LEN=10), PARAMETER :: h="**(ERROR)**"
    write(*,"(a)") h//message
    CALL MPI_ABORT(MPI_COMM_WORLD, ierror, ierr)
    STOP
  END SUBROUTINE FatalError

end Module mod_relogios
